home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Applications / ircle 1.5.1 / source / ircle sources / IRCIgnore.p < prev    next >
Encoding:
Text File  |  1993-11-16  |  4.8 KB  |  206 lines  |  [TEXT/PJMM]
  1. {    ircle - Internet Relay Chat client    }
  2. {    File: IRCIgnore    }
  3. {    Copyright © 1992 Olaf Titz (s_titz@ira.uka.de)    }
  4.  
  5. {    This program is free software; you can redistribute it and/or modify    }
  6. {    it under the terms of the GNU General Public License as published by    }
  7. {    the Free Software Foundation; either version 2 of the License, or    }
  8. {    (at your option) any later version.    }
  9.  
  10. {    This program is distributed in the hope that it will be useful,    }
  11. {    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
  12. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
  13. {    GNU General Public License for more details.    }
  14.  
  15. {    You should have received a copy of the GNU General Public License    }
  16. {    along with this program; if not, write to the Free Software    }
  17. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }
  18.  
  19. unit IRCIgnore;
  20. { Deals with the /ignore command }
  21.  
  22. interface
  23. uses
  24.     TCPTypes, TCPStuff, TCPConnections, ApplBase, MiscGlue, MsgWindows, {}
  25.     IRCGlobals, IRCAux, IRCChannels;
  26.  
  27. procedure InitIRCIgnore;
  28. { Startup }
  29.  
  30. procedure DoIgnore (var s: string);
  31. { handles the /ignore command }
  32. { format: /ignore nick!user@host = ignore nick,user,host}
  33. {    /ignore nick, /ignore user@host do as well}
  34. {     wildcards are ? and * }
  35. {    /ignore +nick!user@host = ignore and give him notice }
  36. {    /ignore = list all ignorations }
  37. {    /ignore -nick!user@host = remove a tag }
  38.  
  39. procedure GetIgnoreList (var s: string);
  40. { Returns the ignore list }
  41.  
  42. function IsIgnored (var s: string; p: boolean): boolean;
  43. { handles messages from s - returns true if ignored. p=message may be answered }
  44.  
  45. implementation
  46.  
  47. const
  48.     DELV = chr(4);    { mark for rude ignore }
  49.     DELS = chr(5);    { mark for silent ignore }
  50.  
  51. var
  52.     ign: CharsHandle;
  53.     maxign: integer;
  54.  
  55. procedure GetIgnoreList (var s: string);
  56.     var
  57.         i: integer;
  58.     begin
  59.         s := '';
  60.         i := 0;
  61.         while i < maxign do begin
  62.             if ign^^[i] = DELV then
  63.                 s := concat(s, '+');
  64.             repeat
  65.                 i := succ(i);
  66.                 if i >= maxign then
  67.                     leave;
  68.                 if ord(ign^^[i]) < 32 then
  69.                     leave;
  70.                 s := concat(s, ign^^[i]);
  71.             until false;
  72.             s := concat(s, ' ');
  73.         end;
  74.     end;
  75.  
  76. procedure ListIgnores;
  77.     var
  78.         s: string;
  79.     begin
  80.         GetIgnoreList(s);
  81.         s := concat('*** Ignore List: ', s);
  82.         Message(s)
  83.     end;
  84.  
  85. procedure DoIgnore (var s: string);
  86.     var
  87.         tag: char;
  88.         i: integer;
  89.         p: string;
  90.     begin
  91.         while s <> '' do begin
  92.             NextArg(s, p);
  93.             if pos('@', p) = 0 then
  94.                 p := concat(p, '!*@*')
  95.             else if pos('!', p) = 0 then
  96.                 p := concat(p[1], '*!', copy(p, 2, 255));
  97.             if p[1] = '-' then begin
  98.                 i := Munger(Handle(ign), 0, @p[2], length(p) - 1, Ptr(1), 0);
  99.                 if i > 0 then
  100.                     i := Munger(Handle(ign), i - 1, nil, 1, Ptr(1), 0);
  101.                 maxign := maxign - length(p);
  102.             end
  103.             else begin
  104.                 if p[1] = '+' then
  105.                     p[1] := DELV
  106.                 else
  107.                     insert(DELS, p, 1);
  108.                 i := length(p);
  109.                 if PtrAndHand(@p[1], Handle(ign), i) = 0 then
  110.                     maxign := maxign + i;
  111.             end;
  112.         end;
  113.         ListIgnores
  114.     end;
  115.  
  116. procedure IgnoreBack (var s: string);
  117.     var
  118.         t: string;
  119.         i: integer;
  120.     begin
  121.         if serverStatus = S_CONN then begin
  122.             t := s;
  123.             i := pos('!', t);
  124.             if i > 0 then
  125.                 t[0] := chr(i - 1);
  126.             t := concat('NOTICE ', t, ' :You are being ignored');
  127.             PutLine(t);
  128.         end;
  129.     end;
  130.  
  131. function upc (c: char): char;
  132.     begin
  133.         if (c >= 'a') and (c <= 'z') then
  134.             upc := chr(ord(c) - 32)
  135.         else
  136.             upc := c
  137.     end;
  138.  
  139. function IsIgnored (var s: string; p: boolean): boolean;
  140.     var
  141.         back: boolean;
  142.         a: integer;
  143.     function matchFrom (i, j: integer): boolean;
  144.         begin
  145.             matchFrom := true;
  146.             repeat
  147.                 if (ign^^[i] < ' ') and (s[j] < ' ') then
  148.                     exit(matchFrom);    { completely matched }
  149.                 if ign^^[i] = '*' then begin
  150.                     i := succ(i);
  151.                     if (i >= maxign) or (ign^^[i] < ' ') then
  152.                         exit(matchFrom); { pattern ended in * : matched }
  153.                     repeat
  154.                         while upc(s[j]) <> upc(ign^^[i]) do begin
  155.                             j := succ(j);
  156.                             if s[j] < ' ' then begin
  157.                                 matchFrom := false; { pattern ended *x , no match for x }
  158.                                 exit(matchFrom);
  159.                             end;
  160.                         end; { pattern *x, , match for x }
  161.                         if matchFrom(i, j) then { check for matching rest }
  162.                             exit(matchFrom);
  163.                         j := succ(j)
  164.                     until s[j] < ' '; { backtrack }
  165.                     matchFrom := false;
  166.                     exit(matchFrom);
  167.                 end
  168.                 else if (ign^^[i] <> '?') then begin
  169.                     if (upc(ign^^[i]) <> upc(s[j])) then begin
  170.                         matchFrom := false;    { Mismatch }
  171.                         exit(matchFrom)
  172.                     end;
  173.                 end;
  174.                 i := succ(i);
  175.                 j := succ(j);
  176.             until false;
  177.         end;
  178.     begin
  179.         s[length(s) + 1] := chr(0);
  180.         a := 0;
  181.         while a < maxign do begin
  182.             back := (ign^^[a] = DELV);
  183.             a := succ(a);
  184.             if matchFrom(a, 1) then begin
  185.                 IsIgnored := true;
  186.                 if p and back then
  187.                     IgnoreBack(s);
  188.                 exit(IsIgnored)
  189.             end;
  190.             repeat
  191.                 a := succ(a);
  192.                 if a >= maxign then
  193.                     leave;
  194.             until ign^^[a] < ' ';
  195.         end;
  196.         IsIgnored := false;
  197.     end;
  198.  
  199.  
  200. procedure InitIRCIgnore;
  201.     begin
  202.         ign := CharsHandle(NewHandle(0));
  203.         maxign := 0;
  204.     end;
  205.  
  206. end.